--- This module deals with Semigroups and Monoids

package Data.Monoid  where

import frege.prelude.PreludeBase (NonEmpty)

infixr 13 `<>` mappend

(<>) = mappend

class Semigroup a where
  mappend :: a -> a -> a
  
  sconcat :: NonEmpty a -> a
  sconcat (NonEmpty a as) = go a as where
    go b (c:cs) = b <> go c cs
    go b [] = b
  
  --doesn't support factor of 0, use mtimes if possible
  stimes :: Int -> a -> a
  stimes n x | n < 1 = error "factor must be positive"
             | n == 1 = x
             | n `rem` 2 == 0 = stimes (n `quot` 2) $ mappend x x
             | otherwise = mappend x $ stimes (n `quot` 2) $ mappend x x 
  
class Semigroup a => Monoid a where
  mempty :: a 
  
  mconcat :: [a] -> a
  mconcat = fold mappend mempty  
  
  mtimes :: Int -> a -> a
  mtimes 0 _ = mempty
  mtimes n x = stimes n x 
  
-- List ----------------------------------------------------------------------- 

instance Monoid [a] where
  mempty = []
  mappend = (++)

-- String ---------------------------------------------------------------------

instance Monoid String where
    mappend = (++)
    mempty  = String.empty
    
-- Unit -----------------------------------------------------------------------

instance Monoid () where
  mempty = ()  
  _ `mappend` _ = ()  

-- Maybe ---------------------------------------------------------------------

instance Semigroup a => Monoid (Maybe a) where
  mempty = Nothing
  Nothing `mappend` b = b
  Just a `mappend` Just b = Just (mappend a b)
  a `mappend` _ = a

-- First ---------------------------------------------------------------------- 

newtype First a = First { getFirst :: Maybe a }
derive Show (First a)
derive Eq (First a)
derive Ord (First a)

instance Monoid (First a) where
  mempty = First Nothing
  First Nothing `mappend` y = y
  x `mappend` _ = x
  
-- Last ----------------------------------------------------------------------- 

newtype Last a = Last { getLast :: Maybe a }
derive Show (Last a)
derive Eq (Last a)
derive Ord (Last a)

instance Monoid (Last a) where
  mempty = Last Nothing
  x `mappend` Last Nothing = x 
  _ `mappend` y = y

-- Ordering -------------------------------------------------------------------

instance Monoid Ordering where
  mempty = Eq
  Lt `mappend` _ = Lt
  Eq `mappend` y = y
  Gt `mappend` _ = Gt  

instance Monoid (a->a) where
    f `mappend` g = f . g
    mempty        = id

-- IO -------------------------------------------------------------------------

instance Monoid a => Monoid (IO a) where
  mempty = return mempty 
  mappend = liftM2 mappend
{- 
--with #FlexibleInstances this would generalize to
instance Semigroup (Monad m, Semigroup a) => m a where
  mappend = liftM2 Semigroup.mappend
instance Monoid (Monad m, Monoid a) => m a where
  mempty = return Monoid.mempty 
-}  
  
